Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/hlp_auth/clak20/generapp.frm

Visual Basic Form | 1995-01-10 | 16.2 KB | 422 lines

VERSION 2.00
Begin Form Clacker_Form
   Caption         =   "Clacker Test"
   ClientHeight    =   5580
   ClientLeft      =   1185
   ClientTop       =   1785
   ClientWidth     =   5070
   Height          =   6270
   Left            =   1125
   LinkTopic       =   "Form1"
   ScaleHeight     =   5580
   ScaleWidth      =   5070
   Top             =   1155
   Width           =   5190
   Begin CommandButton BTN_Command1
      Caption         =   "On/Off"
      Height          =   375
      Left            =   120
      TabIndex        =   6
      Top             =   240
      Width           =   855
   End
   Begin Clack Clacker1
      Prop10          =   "Click for About Box"
      hwndForm        =   0
      Left            =   240
      SystemMenu      =   0   'False
      Top             =   120
   End
   Begin CommandButton BTN_Exit
      Caption         =   "Exit"
      Height          =   375
      Left            =   3720
      TabIndex        =   4
      Top             =   240
      Width           =   1215
   End
   Begin TextBox Text2
      Height          =   2655
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   3
      Text            =   "Text2"
      Top             =   840
      Width           =   4815
   End
   Begin CommandButton Btn_UnHook
      Caption         =   "UnHook"
      Height          =   375
      Left            =   1080
      TabIndex        =   1
      Top             =   240
      Width           =   1215
   End
   Begin CommandButton Btn_Hook
      Caption         =   "Hook"
      Height          =   375
      Left            =   2400
      TabIndex        =   2
      Top             =   240
      Width           =   1215
   End
   Begin TextBox TXT_Result
      Height          =   975
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "Menu ID, menu not hooked"
      Top             =   3720
      Width           =   4815
   End
   Begin Label Label1
      BackColor       =   &H00FFFF80&
      Caption         =   "Label1"
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   4920
      Width           =   4815
   End
   Begin Menu nmu_File
      Caption         =   "&File"
      HelpContextID   =   9
      Tag             =   "mnu_File tag text"
      Begin Menu mnu_New
         Caption         =   "New"
         Tag             =   "mnu_New tag text"
      End
      Begin Menu mnu_Open
         Caption         =   "Open"
         Tag             =   "mnu_Open tag text"
      End
      Begin Menu mnu_Close
         Caption         =   "Close"
         Tag             =   "mnu_Close tag text"
      End
      Begin Menu mnu_Exit
         Caption         =   "&Exit"
         HelpContextID   =   1
         Tag             =   "mnu_Exit tag text"
      End
   End
   Begin Menu mnu_Edit
      Caption         =   "&Edit"
      HelpContextID   =   2
      Tag             =   "mnu_Edit tag text"
      Begin Menu mnu_Cut
         Caption         =   "Cu&t"
         HelpContextID   =   3
         Shortcut        =   ^X
         Tag             =   "mnu_Cut tag text"
      End
      Begin Menu mnu_Copy
         Caption         =   "&Copy"
         HelpContextID   =   4
         Shortcut        =   ^C
         Tag             =   "mnu_Copy tag text"
      End
      Begin Menu mnu_Paste
         Caption         =   "&Paste"
         HelpContextID   =   5
         Shortcut        =   ^V
         Tag             =   "mnu_Paste tag text"
      End
      Begin Menu mnu_EditSubmenu
         Caption         =   "Edit SubMenu"
         HelpContextID   =   6
         Tag             =   "mnu_EditSubmenu tag text"
         Begin Menu mnu_EditSubmenu1
            Caption         =   "Edit SubMenu 1"
            HelpContextID   =   7
            Tag             =   "mnu_EditSubmenu1 tag text"
         End
         Begin Menu mnu_EditSubmenu2
            Caption         =   "Edit SubMenu 2"
            HelpContextID   =   8
            Tag             =   "mnu_EditSubmenu2 tag text"
         End
      End
   End
   Begin Menu mnu_View
      Caption         =   "&View"
      Tag             =   "mnu_View tag text"
      Begin Menu mnu_View1
         Caption         =   "View 1"
         Tag             =   "mnu_View1 tag text"
      End
      Begin Menu mnu_View2
         Caption         =   "View 2"
         Tag             =   "mnu_View2 tag text"
      End
      Begin Menu mnu_ViewSubMenu
         Caption         =   "View SubMenu"
         Tag             =   "mnu_ViewSubMenu tag text"
         Begin Menu mnu_ViewSubMenu1
            Caption         =   "View SubMenu 1"
            Tag             =   "mnu_ViewSubMenu1 tag text"
         End
         Begin Menu mnu_ViewSubMenu2
            Caption         =   "View SubMenu 2"
            Tag             =   "mnu_ViewSubMenu2 tag text"
         End
      End
   End
Option Explicit
Const CLACKER_START = 1
Const CLACKER_STOP = 2
Dim CRLF As String
Dim MenuStatus(1 To 25) As HelpTextType  '' help string array
Dim LocalMenuIDArray() As Long           '' local menu ID array
Sub BTN_Command1_Click ()
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' COMMENT: Switches a menu item on and off...just to show how
''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If mnu_Copy.Visible Then
        mnu_Copy.Visible = False
        BTN_Command1.Caption = "OFF"
    Else
        mnu_Copy.Visible = True
        BTN_Command1.Caption = "ON"
    End If
    '' fill the local array
    Clacker1.RefreshHwnd = Me.hWnd
End Sub
Sub BTN_Exit_Click ()
    '' user initiated exit
    mnu_Exit_Click
End Sub
Sub Btn_Hook_Click ()
'' PURPOSE: Hook up the menu to CLACKER.VBX
'' COMMENTS: Each form with a menu to monitor
''           should have a similar statement block
'''''''''''''''''''''''''''''''''''''''''''''''''''
    '' set the HWND of this form
    Clacker1.hwndForm = Me.hWnd
    Debug.Print Hex$(Me.hWnd)
    '' issue the action command
    Clacker1.Action = CLACKER_START   ''1
    '' put up some status info
    TXT_Result.Text = "Menu ID, menu hooked"
End Sub
Sub Btn_UnHook_Click ()
    '' user initiated unhook command
    '' unhook the menu
    Clacker1.Action = CLACKER_STOP  ''2
    '' some status text
    TXT_Result.Text = "Menu Unhooked"
    Label1.Caption = ""
End Sub
Sub Clacker1_ClackerClick (MenuName As String, TagText As String, MenuCaption As String, MenuID As Integer, hMenu As Integer)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PURPOSE: Determine which menu was hit.
' COMMENTS: Clacker.vbx returns all the values shown from windows.
'           Read the SDK docs, to better understand Window's menu behavior.
'           Parametrs returned are:
'               hMenu the menu handle
'               MenuID the resource ID of the menu ( actually a Unsigned Integer )
'               MenuCaption the menu caption text
' NOTES:    1. It is not necessary to make use of all of the return params.
'               Using only the MenuID is suffecient to retreive the stored text.
'           2. Clacker does not return a caption for all menu hits. Windows does
'               not provide return captions for typically unused menu items,
'               ie, separators and those menu items which are processed by
'               Window's default menuprocs.
'           3. Separators return MenuID = 0 for all of them.
'           4. Top level menus and submenus return hMenu = MenuID.
'           5. How to get to the status text...
'               Make a text array with the text strings you want to use for each menu item
'               Use the ndex value as a position of the match to fetch the text string.
'           6. Break Points in this Sub suspends execution in a menu call so the VB menus
'               will be disabled until the Sub exits. Use Debug.Print statements instead
'               of break points to debug you code.
'           7. Use a label control to display the menu caption as underlined
'           VB-1 NOTE:  VB1 does not return the MenuName or TagText property. Both will be
'                       returned as NULL strings when VB1 is used. The Caption property and
'                       the hMenu/MenuID values can be used to determine VB1 menu items.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Msg As String
Dim ndex As Integer
Dim lMenuID As Long
    ' clear the junk...
    TXT_Result.Text = ""
    ' for vb2-3 use the following code
    If MenuName = "" And MenuCaption = "" Then
        ' if MenuCaption = ""
        ' then it is a system menu or a separator bar
        ' clear the status text if you want to
        TXT_Result.Text = "Menu Clear"
        ' make the label show the same text
        Label1.Caption = TXT_Result.Text
    ElseIf MenuName = "" Then
        ' detects a system menu item
        TXT_Result.Text = "System Menu = " & MenuCaption
        ' make the label show the same text
        Label1.Caption = TXT_Result.Text
    Else
        ' regular VB menu item
        '
        ' use a label caption to cause the formating
        ' of underline character
        ' the text we want is stored in the
        ' tag property of the menu item
        Label1.Caption = TagText
        ' this is just some data to display in the text box
        TXT_Result.Text = "VB Menu item name = " + MenuName + CRLF + "VB Menu item hMenu = " + Str$(hMenu) + CRLF + "MenuID = " + Str$(MenuID) + CRLF + "Menu Caption = " + MenuCaption
    End If
    Debug.Print "MenuName    = "; MenuName
    Debug.Print "MenuCaption = "; MenuCaption
    Debug.Print "TagText     = "; TagText
Exit Sub
    '
    ' The following illustrates what can be done for VB1 useage.
    '
    '
    ' for simple status text
    ' use a select case statement
    ' match up the MenuCaption returned to the VB Menu Caption property
    '       include the underline character as appropiate
    ' display the text based on the result of the switch statement.
    Select Case MenuCaption

        Case "File"
            Label1.Caption = "Open, Close, exit"
        Case "Edit"
            Label1.Caption = "Edit, Cut, Copy, Paste text"
        Case "View"
            Label1.Caption = "View menu choices"
    End Select
End Sub
Sub Clacker1_ClearStatusClick ()
'' PURPOSE: Event returned by CLACKER.VBX
''COMMENTS: Event is returned when a menu item is
''          actually selected by the user.
'' USEAGE:  Clear the status line of text if desired
''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Msg As String
    Msg = "Illustrates the clear function for the staus text." + CRLF
    Msg = Msg + "You would normally just output a blank line" + CRLF
    Msg = Msg + "when a menu command is actually executed."
    TXT_Result.Text = Msg
    Label1.Caption = ""
End Sub
Sub Clacker1_RefreshHwndClick (MenuItemCount As Integer)
'' PURPOSE: Event returned by CLACKER.VBX
''COMMENTS: Event is returned in response to the CLACKER.VBX
''          being issued the command "Clacker1.RefreshHwnd = [HWND]
'' USEAGE:  Load the local array from the CLACKER.VBX control
''          with the menu IDs of all menu items associated
''          with the hwnd sent.
''          This local array is then used for finding the position of the
''          status text to display.
''          The MenuID returned in the array is the same as the MenuID parameter
''          returned in the ClackerClick() event
''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ndex As Integer
Dim Msg As String
    '' A return value of 0 indicates the menu was not found
    '' or the hwnd passed was no good
    If (MenuItemCount = 0) Then
        ' just for debugging, don't use in final apps
        MsgBox "MenuItemCount = 0"
        Exit Sub
    Else
        Debug.Print ""
        Debug.Print "MenuItemCount = "; MenuItemCount
        Label1.Caption = "Menu Item Count = " + Str$(MenuItemCount)
    End If
    '' set the array size to MenuItemCount
    ReDim LocalMenuIDArray(1 To MenuItemCount)
    '' fill the array
    For ndex = 1 To MenuItemCount
        '' move the data to the loacal array
        LocalMenuIDArray(ndex) = Clacker1.MenuIDArray(ndex)
        '' for diagnostic use to show what is going on
        '' put up data we stored
        ''Debug.Print "LocalMenuIDArray(" + Str$(ndex) + ") = "; Str$(Clacker1.MenuIDArray(ndex))
    Next ndex
End Sub
Sub Form_Load ()
Dim hSysMenu As Integer
Dim hMainMenu As Integer
Dim Msg As String
Dim ndex As Integer
    '' first load the global constant
    CRLF = Chr$(13) + Chr$(10)
    If Me.WindowState = 0 Then
        Top = 0
        Left = 0
    End If
    '' set the HWND of this form
    Clacker1.hwndForm = Me.hWnd
    '' issue the action command to start sending menu message notifications to your VB app
    Clacker1.Action = CLACKER_START   ''1
    '' If you DO NOT wish to use the array approach to matching MenuID to
    '' the help text, then it is not necessary to use the following lines of code
    '' JUST EXIT HERE
    '' fill the local array
    Clacker1.RefreshHwnd = Me.hWnd
    ''
    '' The array is filled and the event
    '' Clacker1_RefreshHwndClick (MenuItemCount As Integer)
    '' is used to transfer the values into the LocalHwndArray[]
    ''
    ''
End Sub
Sub Form_Resize ()
    If Me.WindowState = 0 Then
        Me.Height = 6270
        Me.Width = 5175
    End If
End Sub
Sub Form_Unload (Cancel As Integer)
    '' good programming practice to clean up
    '' unhook the menu
    Clacker1.Action = CLACKER_STOP  ''2
End Sub
Sub MenuHelpText ()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  PURPOSE: Load the help text string in the array.
' COMMENTS: Make sure you provide an entry for each menu in your
'           menu system, even if it won't be used. This helps when
'           laying out the help system and with debugging.
'    NOTES: 1. To conserve stack space in the main module
'               place the text strings and the array in another module
'           2. The MenuStatus array size must be equal to or great than the total
'               number of menu items in the form, or else a bounds error will occur.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    MenuStatus(1).strHelpMsg = "<System Menu>"
    MenuStatus(2).strHelpMsg = "Restore previous window position"
    MenuStatus(3).strHelpMsg = "Move the current window Window"
    MenuStatus(4).strHelpMsg = "Change the size of current Window"
    MenuStatus(5).strHelpMsg = "Minimize current Window"
    MenuStatus(6).strHelpMsg = "Maximize current Window"
    MenuStatus(7).strHelpMsg = "[separator]"        '[separator], no MenuID and no text
    MenuStatus(8).strHelpMsg = "Close current Window"
    MenuStatus(9).strHelpMsg = "[separator]"        '[separator], no MenuID and no text
    MenuStatus(10).strHelpMsg = "Switch to different task"
    MenuStatus(11).strHelpMsg = "<Main Form Menu>"
    MenuStatus(12).strHelpMsg = "<File Menu>"
    MenuStatus(13).strHelpMsg = "Exit the program"
    MenuStatus(14).strHelpMsg = "<Edit Menu>"
    MenuStatus(15).strHelpMsg = "Cut selected text from document"
    MenuStatus(16).strHelpMsg = "Copy selected text to clipboard"
    MenuStatus(17).strHelpMsg = "Paste clipboard text into document"
    MenuStatus(18).strHelpMsg = "Main Submenu text"
    MenuStatus(19).strHelpMsg = "Submenu1 text message"
    MenuStatus(20).strHelpMsg = "Submenu2 text message"
End Sub
Sub mnu_Close_Click ()
    '
    ' process should not terminate with menus still hooked in dll
    Clacker1.Action = CLACKER_STOP  ''2
    End
End Sub
Sub mnu_Exit_Click ()
    '
    ' process should not terminate with menus still hooked in dll
    Clacker1.Action = CLACKER_STOP  ''2
    End
End Sub